home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / NEETVGA / RGB / FERN0.PAS next >
Pascal/Delphi Source File  |  1993-02-12  |  3KB  |  131 lines
  1. {*****************************************************************************}
  2. {*****                <<<Copywright by the gods of the computer>>>      ******}
  3. {*****                           Fernando Padilla                       ******}
  4. {*****                            Steve Markham                         ******}
  5. {*****                  Idea and original code by: Roger Yarrow         ******}
  6. {*****************************************************************************}
  7. uses
  8.    crt,graph;
  9. type
  10.    RGB=(R,RG,G,GB,B,BW,W);
  11. Var
  12.    i,j:Integer;
  13.    z:Array[1..768] Of Byte;
  14.    c:RGB;
  15.    s:Boolean;
  16.  
  17. procedure setupgraph(Gd,Gm:integer);
  18. begin
  19.      InitGraph(Gd,Gm,'c:\tp\bgi');
  20.      if GraphResult<>grOk then halt;
  21.      cleardevice;
  22. end;
  23.  
  24. procedure putouttextcenterof(xs,ys:integer;  temp:string);
  25.   procedure cleartextarea(xs,ys:integer;  temp:string);
  26.   var
  27.      txh,txw:integer;
  28.   begin
  29.      txh:=textheight(temp); txw:=textwidth(temp);
  30.      setcolor(0);
  31.      bar(xs-(txw div 2),ys-(txh div 2),xs+(txw div 2)-1,ys+(txh div 2)-1);
  32.      setcolor(1);
  33.   end;
  34. begin
  35.    settextjustify(centertext,centertext);
  36.    cleartextarea(xs,ys,temp);
  37.    setcolor(2);
  38.    outtextxy(xs,ys,temp);
  39.    settextjustify(lefttext,lefttext);
  40. end;
  41.  
  42. Procedure Store;
  43. Begin
  44.    i := 0;
  45.    j := 1;
  46.    For i := 0 To 255 Do
  47.    Begin
  48.       Port[$3C7] := i;
  49.       z[j] := Port[$3C9];  Inc(j);
  50.       z[j] := Port[$3C9];  Inc(j);
  51.       z[j] := Port[$3C9];  Inc(j);
  52.    End;
  53. End;
  54.  
  55. Procedure SetColor(a,b,c,d : Integer);
  56.   procedure displayrgb(a,b,c,d:integer);
  57.   var
  58.      temp7,temp9r,temp9g,temp9b:string;
  59.   begin
  60.      str(a,temp7);
  61.      str(b,temp9r);
  62.      str(c,temp9g);
  63.      str(d,temp9b);
  64.      putouttextcenterof(getmaxx div 2,100,concat('Color: ',temp7));
  65.  
  66.      putouttextcenterof((getmaxx div 2)-50,120,temp9r);
  67.      putouttextcenterof((getmaxx div 2)-50,140,'RED');
  68.  
  69.      putouttextcenterof(getmaxx div 2,120,temp9g);
  70.      putouttextcenterof(getmaxx div 2,140,'GREEN');
  71.  
  72.      putouttextcenterof((getmaxx div 2)+50,120,temp9b);
  73.      putouttextcenterof((getmaxx div 2)+50,140,'BLUE');
  74.      delay(10);
  75.   end;
  76. Begin
  77.    Port[$3C8] := a;
  78.    Port[$3C9] := b;
  79.    Port[$3C9] := c;
  80.    Port[$3C9] := d;
  81.    Displayrgb(a,b,c,d);
  82. End;
  83.  
  84. Procedure Restore;
  85. Begin
  86.    i := 0;
  87.    j := 1;
  88.    For i := 0 To 1 Do
  89.    Begin
  90.       SetColor(i,z[j],z[j+1],z[j+2]);
  91.       Inc(j,3);
  92.    End;
  93. End;
  94.  
  95. Procedure FadeColor(c : RGB);
  96. Const
  97.    base=0;
  98.    Top=63;
  99.   Procedure DoColor(c : RGB);
  100.   Begin
  101.      if s then exit;
  102.      Case c of
  103.         R: SetColor(0,i,0,0);
  104.         RG:SetColor(0,i,i,0);
  105.         G: SetColor(0,0,i,0);
  106.         GB:SetColor(0,0,i,i);
  107.         B: SetColor(0,0,0,i);
  108.         BW:SetColor(0,i div 2,i div 2,i);
  109.         W: SetColor(0,i,i,i);
  110.  
  111.      end;
  112.      s:=keypressed;
  113.   end;
  114. Begin
  115.    if s then exit;
  116.    For i := base To top Do Docolor(c);
  117.    For i := top DownTo base Do Docolor(c);
  118. end;
  119.  
  120. Begin
  121.    Randomize;
  122.    setupgraph(ega,egahi);
  123.    setbkcolor(0);
  124.    store;
  125.    s:=false;
  126.    Repeat
  127.      for c:=R to W do
  128.       FadeColor(c);
  129.    Until KeyPressed or s;
  130.    Restore;
  131. End.